home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
q4tool.zip
/
Q4T-DEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-06-27
|
21KB
|
463 lines
'----------------------------------------------------------------------------
' ** Q4T-DEMO.BAS **
' Demonstration of the capabilities of the Q4Tool Library routines
' Written for and compiled with Microsoft (R), QuickBASIC 4.00b (C)
' By R. J. Crouch - June 1990
' Copyright - 1990 - CareWare
' All Rights Reserved
'----------------------------------------------------------------------------
' For Q4tool v.1.1
REM $INCLUDE: 'Q4T.BI' ' Contains declarations for
' Ctr() and Delay()
DEFINT A-Z
TYPE RegType ' Necessary for the CALL to
ax AS INTEGER ' the QB's Interrupt()
bx AS INTEGER ' routine
cx AS INTEGER '
dx AS INTEGER ' Generally placed in the
bp AS INTEGER ' "$INCLUDE:" file
si AS INTEGER '
di AS INTEGER '
flags AS INTEGER '
END TYPE '
DIM InReg AS RegType, OutReg AS RegType ' Typed for Interrupt()
DIM ScrnBuf(8) AS STRING * 4000 ' Room for 9 screens
' w/ option base 0
FALSE = 0: TRUE = NOT FALSE ' Flags
CONST CONT = "Press any key to continue" ' Prompts
CONST MCONT = "Left mouse button to continue" '
b1$ = CHR$(221) + " ": b2$ = " " + CHR$(222) ' Brackets
cpyr$ = b1$ + "Copyright - 1990 - CareWare" + b2$
mpos1$ = b1$ + "Row ## - Col ##" + b2$ ' Formats for
mpos2$ = b1$ + "Y ### - X ###" + b2$ ' PRINT USING
buttons = 0
'ON KEY(10) GOSUB Terminate ' For programming
'KEY(10) ON ' purposes only
'----------------------------------------------------------------------------
'Title Screen
'----------------------------------------------------------------------------
COLOR 0, 1, 0: CLS
CALL DoWindow(2, 6, 23, 69, 14, 6, 5, 0, "Q4Tool Demo", 2)
CALL PrtScrn(cpyr$, 24, 25, 110)
CALL DoWindow(5, 13, 16, 55, 15, 0, 5, 3, CONT, 3)
FOR row = 7 TO 16
READ line$: lctr = Ctr(line$)
IF row < 10 THEN att = 12 ELSE att = 14
CALL PrtScrn(line$, row, lctr, att)
NEXT row
READ line$
CALL PrtScrn(line$, row + 1, lctr, 10)
CALL PutScrn(ScrnBuf(0))
CALL Delay(0, 0)
CALL MouseStatus(have) ' Check for mouse interrupt
IF have THEN ' Ask to use mouse
CALL DoWindow(7, 16, 12, 49, 12, 0, 1, 0, "", 0)
CALL PrtScrn(STRING$(29, 220), 20, 26, 15)
CALL MouseVersion(ver$)
FOR row = 9 TO 14
READ line$: lcrt = Ctr(line$)
CALL PrtScrn(line$, row, lctr, 14)
IF row = 10 THEN CALL PrtScrn(ver$, row, lctr + 26, 10)
NEXT row
finish! = TIMER + 30
DO
i$ = UCASE$(INKEY$) ' Wait for key
now! = TIMER ' or 30 sec.
LOOP UNTIL i$ = "N" OR i$ = "Y" OR now! > finish!
IF i$ = "Y" THEN ' Initialize mouse driver
prompt$ = MCONT: pctr = Ctr(MCONT) ' Use mouse prompt
CALL MouseReset(buttons) ' Return # of buttons
mouse = TRUE
ELSE ' Mouse not wanted
prompt$ = CONT: pctr = Ctr(CONT) ' Use key prompt
mouse = FALSE
END IF
CALL PrtScrn(prompt$, 16, pctr, 10)
CALL Delay(30, 0)
ELSE ' No mouse detected
FOR x = 1 TO 6: READ nul$: NEXT x ' Skip mouse text data
END IF
CALL GetScrn(ScrnBuf(0)) ' Retrieve opening screen
IF mouse THEN CALL PrtScrn(b1$ + prompt$ + b2$, 20, pctr - 2, 15)
CALL Delay(60, 0)
CLS
CALL DoWindow(8, 14, 9, 53, 13, 0, 5, 3, prompt$, 3)
FOR row = 11 TO 13
READ line$: lctr = Ctr(line$)
CALL PrtScrn(line$, row, lctr, 15)
NEXT row
CALL Delay(60, 0)
'----------------------------------------------------------------------------
'Frame types and screen save/restore
'----------------------------------------------------------------------------
COLOR 0, 0, 0: CLS
col = 0: frm = -1: scrn = -1
bgd = 0: fgd = 15
FOR row = 2 TO 14 STEP 3
col = col + 6: bgd = bgd + 1
frm = frm + 1: fgd = fgd - 1
CALL DoWindow(row, col, 10, 20, fgd, bgd, frm, 0, "Window", 2)
scrn = scrn + 1
CALL PutScrn(ScrnBuf(scrn)) ' Screen save w/PutScrn()
NEXT row
FOR row = 11 TO 2 STEP -3
col = col + 6: bgd = bgd + 1
frm = frm + 1: fgd = fgd - 1
IF frm = 6 THEN frm = 1
IF fgd = 9 THEN fgd = 14
CALL DoWindow(row, col, 10, 20, fgd, bgd, frm, 0, "Q4Tool", 3)
IF scrn < 8 THEN ' Save all but last screen
scrn = scrn + 1
CALL PutScrn(ScrnBuf(scrn)) ' Save screens for later use
END IF
NEXT row
FOR row = 3 TO 9
READ line$
CALL PrtScrn(line$, row, col + 2, 31)
NEXT row
CALL PrtScrn(prompt$, 25, pctr, 10)
CALL Delay(60, 0)
CALL DoWindow(9, 12, 7, 56, 15, 0, 5, 0, "", 3)
FOR row = 11 TO 13
READ line$: lctr = Ctr(line$)
CALL PrtScrn(line$, row, lctr, 10)
NEXT row
CALL Delay(60, 0)
FOR show = 7 TO 0 STEP -1
CALL GetScrn(ScrnBuf(show)) ' Retrieve saved screens
NEXT show
FOR row = 5 TO 7
CALL PrtScrn("* Fast *", row, 11, 16)
NEXT row
CALL Delay(2, 0)
CALL DoWindow(10, 12, 7, 56, 15, 0, 5, 0, prompt$, 3)
FOR row = 12 TO 13
READ line$: lctr = Ctr(line$)
CALL PrtScrn(line$, row, lctr, 10)
NEXT row
CALL Delay(60, 0)
FOR show = 1 TO 8
CALL GetScrn(ScrnBuf(show)) ' Screen restore w/GetScrn()
CALL Delay(.33, 0) ' .33 second delay added
NEXT show
CALL PrtScrn("Now a three", 5, 58, 31)
CALL PrtScrn("second delay", 7, 58, 31)
CALL Delay(3, 0)
FOR show = 8 TO 0 STEP -1
CALL GetScrn(ScrnBuf(show))
CALL Delay(.33, 0)
NEXT show
CALL DoWindow(2, 6, 10, 20, 4, 7, 5, 0, "Q4Tool", 2)
CALL PrtScrn("* Next *", 5, 11, 112)
CALL PrtScrn("Shadow Styles", 7, 10, 112)
CALL PrtScrn(prompt$, 25, pctr, 10)
CALL Delay(60, 0)
'----------------------------------------------------------------------------
'Shadowing
'----------------------------------------------------------------------------
CLS
CALL DoWindow(1, 1, 25, 80, 9, 3, 5, 0, prompt$, 3)
CALL DoWindow(2, 21, 3, 38, 0, 7, 1, 0, "", 0)
CALL DoWindow(6, 41, 18, 35, 1, 1, 0, 0, "", 0)
READ line$: lctr = Ctr(line$)
CALL PrtScrn(line$, 3, lctr, 117)
FOR row = 7 TO 16 STEP 9
FOR col = 8 TO 43 STEP 35
shadow = shadow + 1: back = back + 1
CALL DoWindow(row, col, 7, 30, 14, back, back, shadow, "", 0)
FOR x = row + 2 TO row + 4
READ line$
CALL PrtScrn(line$, x, col + 5, back * 16)
NEXT x
NEXT col
back = back + 1
NEXT row
CALL PutScrn(ScrnBuf(0))
CALL Delay(60, 0)
CALL DoWindow(8, 9, 10, 62, 14, 0, 5, 0, prompt$, 3)
FOR row = 10 TO 14
READ line$: lctr = Ctr(line$)
IF row < 12 THEN att = 15 ELSE att = 10
CALL PrtScrn(line$, row, lctr, att)
NEXT row
CA